home *** CD-ROM | disk | FTP | other *** search
/ The Best of MacTutor - S…e Code for Volumes 1 to 5 / The Best of MacTutor - Source Code for Volume 1-5 (Wayzata Technology)(6031)(1990).bin / Source Code / #05 (Dec85-Jan86) / basic / icon game 1-13 / Icon Match next >
Text File  |  1985-10-15  |  7KB  |  254 lines
  1. 'Icon Match Game
  2. 'By Dave Kelly
  3. 'MACTUTOR ©1985
  4.  
  5. 'Main Program intialization
  6. WINDOW CLOSE 1
  7. DEFINT a-z   'set variables as type integer
  8. Iconsize%=500
  9. DIM length(12),Icon$(12),Iconput%(Iconsize%,12),r%(24),door(24)
  10. FOR i= 0 TO 3:patt%(i)=&H55AA:NEXT i  'set up pattern
  11. true=-1:false=0:opened=-1:closed=0:found=1:iconloaded=false
  12.  
  13. 'set up menus
  14. FOR i=3 TO 5: MENU i,0,0,"": NEXT i
  15. MENU 1,0,1,"Icon Match"
  16. MENU 1,1,0,"Start Game (Current Icons)"
  17. MENU 1,2,1,"New Game (New Icons)"
  18. MENU 1,3,0,"-"
  19. MENU 1,4,1,"CREATE New Icons"
  20. MENU 1,5,0,"-"
  21. MENU 1,6,1,"Quit"
  22. setmenu:ON MENU GOSUB Mcheck:MENU ON
  23. endlessloop:IF iconloaded THEN MENU 1,1,1 ELSE MENU 1,1,0
  24.     GOTO endlessloop
  25.  
  26. Mcheck: 'check item for menu 1
  27.     menunum=MENU(0):IF menunum <>1 THEN MENU:RETURN
  28.     menuitem=MENU(1):MENU
  29.     ON menuitem GOSUB Startgame,Newgame,,Createicons,,Quit
  30.     RETURN
  31.     
  32. Newgame:
  33.     iconloaded=false
  34. Startgame:
  35.     IF iconloaded=false THEN GOSUB Readicons
  36.     IF filename$="" THEN RETURN
  37.     MENU 1,1,0:MENU 1,2,0:MENU 1,4,0
  38.     numberfound=0:guesses=0
  39.     GOSUB Shuffle 'shuffle icons
  40.     WINDOW 1,,(2,40)-(510,275),3
  41.     MENU ON
  42.     FOR i=1 TO 24
  43.         door(i)=closed
  44.     NEXT i
  45.     GOSUB Play
  46.     WINDOW CLOSE 1
  47.     MENU 1,1,1:MENU 1,2,1:MENU 1,4,1
  48. RETURN
  49.  
  50. Drawstatus:  'Draw the screen with current status
  51.     i=1
  52.     x1=30:y1=30:x2=50+x1:y2=50+y1
  53.     WHILE i<=24
  54.     rect%(0)=y1:rect%(1)=x1:rect%(2)=y2:rect%(3)=x2
  55.     IF door(i)=found THEN ERASERECT(VARPTR(rect%(0))):GOTO skip
  56.     IF door(i)=closed THEN CALL FILLRECT(VARPTR(rect%(0)),VARPTR(patt%(0))):CALL FRAMERECT(VARPTR(rect%(0)))
  57.     IF door(i)=opened THEN ERASERECT(VARPTR(rect%(0))):PUT(x1,y1)-(x2-1,y2-1),Iconput%(0,r%(i))
  58. skip:x1=x1+55:x2=x2+55:i=i+1
  59.     IF i=9 THEN x1=30:y1=y2+5:x2=50+x1:y2=50+y1
  60.     IF i=17 THEN x1=30:y1=y2+5:x2=50+x1:y2=50+y1
  61.     WEND
  62.     RETURN
  63.     
  64. Play:
  65.     FOR i=1 TO 24
  66.         IF door(i)=opened THEN door(i)=closed
  67.     NEXT i
  68.     mousee=MOUSE(0)
  69.     GOSUB Drawstatus
  70.  
  71. Open1stdoor:
  72.     mousee=MOUSE(0):IF mousee=0 THEN Open1stdoor
  73.     GOSUB finddoor
  74.     IF doornum=0 OR door(doornum)=found THEN Open1stdoor
  75.     door(doornum)=opened:doorA=doornum
  76.     GOSUB Drawstatus
  77.     mousee=MOUSE(0)
  78. Open2nddoor:
  79.     mousee=MOUSE(0):IF mousee=0 THEN Open2nddoor
  80.     GOSUB finddoor
  81.     IF doornum=0 OR door(doornum)=found OR doornum=doorA THEN Open2nddoor
  82.     door(doornum)=opened:doorB=doornum
  83.     GOSUB Drawstatus
  84.     IF r%(doorA)=r%(doorB) THEN door(doorA)=found:door(doorB)=found:numberfound=numberfound+1
  85.     guesses=guesses+1:CALL TEXTFONT(0):CALL MOVETO(100,210):PRINT "Number of Guesses:";guesses;"  Number found:";numberfound
  86.     FOR i=1 TO 2000:NEXT i
  87.     IF numberfound<>12 THEN Play
  88. RETURN
  89.  
  90. finddoor:
  91. doornum=0:row1=0:row2=8:row3=16
  92. xpos=MOUSE(1):ypos=MOUSE(2)
  93. IF xpos>465 OR xpos <30 OR ypos <30 OR ypos >190 THEN RETURN
  94.  
  95. rows:'Find selected row
  96. IF ypos>=30 AND ypos <=80 THEN doornum=doornum+row1:GOTO cols
  97. IF ypos>=85 AND ypos <=135 THEN doornum=doornum+row2:GOTO cols
  98. IF ypos>=140 AND ypos <=190 THEN doornum=doornum+row3:GOTO cols
  99. RETURN
  100. cols:'Find selected column
  101. IF xpos>=30 AND xpos<=80 THEN doornum=doornum+1:RETURN
  102. IF xpos>=85 AND xpos<=135 THEN doornum=doornum+2:RETURN
  103. IF xpos>=140 AND xpos<=190 THEN doornum=doornum+3:RETURN
  104. IF xpos>=195 AND xpos<=245 THEN doornum=doornum+4:RETURN
  105. IF xpos>=250 AND xpos<=300 THEN doornum=doornum+5:RETURN
  106. IF xpos>=305 AND xpos<=355 THEN doornum=doornum+6:RETURN
  107. IF xpos>=360 AND xpos<=410 THEN doornum=doornum+7:RETURN
  108. IF xpos>=415 AND xpos<=465 THEN doornum=doornum+8:RETURN
  109. doornum=0
  110. RETURN
  111.  
  112. Shuffle:
  113.     WINDOW 2,,(150,100)-(350,150),-2
  114.     TEXTFONT(0):LOCATE 1,3:PRINT "Please wait...."
  115.     LOCATE 2,3:PRINT"Now shuffling icons."
  116.     RANDOMIZE TIMER
  117.     r%(1)=1:r%(2)=2:r%(3)=3:r%(4)=4:r%(5)=5:r%(6)=6
  118.     r%(7)=7:r%(8)=8:r%(9)=9:r%(10)=10:r%(11)=11:r%(12)=12
  119.     r%(13)=1:r%(14)=2:r%(15)=3:r%(16)=4:r%(17)=5:r%(18)=6
  120.     r%(19)=7:r%(20)=8:r%(21)=9:r%(22)=10:r%(23)=11:r%(24)=12
  121. mixstart=1:mixend=12:GOSUB mixup
  122. mixstart=13:mixend=24:GOSUB mixup
  123. FOR i=1 TO 12:SWAP r%(i),r%(i+6):NEXT i
  124. WINDOW CLOSE 2
  125. RETURN
  126.  
  127. mixup:
  128.     FOR i = mixstart TO mixend
  129.         getnewrnd:
  130.             r%(i)=INT(RND*12.4):IF r%(i)= 0 THEN getnewrnd
  131.             getanother=0
  132.             FOR j=mixstart TO i-1
  133.                 IF r(i)=r(j) THEN getanother=1
  134.             NEXT j
  135.             IF getanother=1 THEN GOTO getnewrnd
  136.     NEXT i
  137. RETURN
  138.  
  139. Quit:
  140.     CLS:MENU RESET:END
  141.  
  142. Createicons:
  143. 'Match Game Icon Creator
  144. '
  145. 'Make your Icon in MacDraw or MacPaint
  146. 'then copy to scrapbook.  This program will
  147. 'read your Icon from the clipboard.
  148. 'CAUTION: click once on the output window before copying
  149. 'if you don't want to close scrapbook for
  150. 'multiple clips.  Use Add to add an icon to the file.
  151. 'Pictures of any size may be used.  They will be scaled
  152. 'when clipped from the clipboard.
  153. MENU 1,0,0
  154. MENU 3,0,1,"Add Match Icons"
  155. MENU 3,1,1,"Display Current Icons"
  156. MENU 3,2,1,"Add an Icon"
  157. MENU 3,3,0,"-"
  158. MENU 3,4,1,"Save Current Icons to disk"
  159. MENU 3,5,1,"Read Current Icons from disk"
  160. MENU 3,6,0,"-"
  161. MENU 3,7,1,"Clear Icons"
  162. MENU 3,8,1,"Return to Match Game"
  163. WINDOW 1,,(2,40)-(510,275),3
  164.  
  165. ON MENU GOSUB Checkmenu:MENU ON
  166. Infiniteloop:
  167.     IF iconloaded=false THEN MENU 3,4,0:MENU 3,2,1
  168.     IF iconloaded=true THEN MENU 3,4,1:MENU 3,2,0
  169.     GOTO Infiniteloop
  170.     
  171. Checkmenu:  'check items FOR MENU 3
  172.     menunum=MENU(0): IF menunum<>3 THEN RETURN
  173.     menuitem=MENU(1): MENU
  174.     ON menuitem GOSUB Displayicons,Add,,SaveALL,Readicons,,Startover,Quitcreate
  175.     RETURN
  176.  
  177. Startover: 'Clear all icons
  178.     CLS:count=0
  179.     iconloaded=false
  180. RETURN
  181.  
  182. Add:  'add an icon to the file
  183.     count=count+1
  184.     GOSUB CopyfromClip
  185.     GOSUB Displayicons
  186.     IF count=12 THEN iconloaded=true
  187. RETURN
  188.  
  189. CopyfromClip:  'copy picture from clipboard
  190.     OPEN "CLIP:PICTURE" FOR INPUT AS 1
  191.     length(count)=LOF(1)
  192.     Icon$(count)=INPUT$(length(count),1)
  193.     CLOSE 1
  194. RETURN
  195.  
  196. Quitcreate:  'quit icon creation
  197.     WINDOW CLOSE 1
  198.     MENU 3,0,0,""
  199.     MENU 1,0,1
  200.     RETURN setmenu
  201.     
  202. SaveALL:
  203.     filename$=FILES$(0,"Enter Icon Filename:")
  204.     IF filename$="" THEN RETURN
  205.     WINDOW 2,,(150,100)-(350,150),-2
  206.     TEXTFONT(0):LOCATE 1,3:PRINT "Please wait...."
  207.     LOCATE 2,3:PRINT"Now saving icons."
  208.     OPEN filename$ FOR OUTPUT AS 1
  209.     FOR count=1 TO 12
  210.         FOR size= 0 TO Iconsize%
  211.             WRITE #1,Iconput%(size,count)
  212.         NEXT size
  213.     NEXT count
  214.     count=12
  215.     CLOSE 1
  216.     NAME filename$ AS filename$,"BICN"
  217.     WINDOW CLOSE 2
  218. RETURN
  219.  
  220. Readicons:
  221.     filename$=FILES$(1,"BICN")
  222.     IF filename$="" THEN RETURN
  223.     WINDOW 2,,(150,100)-(350,150),-2
  224.     TEXTFONT(0):LOCATE 1,3:PRINT "Please wait...."
  225.     LOCATE 2,3:PRINT"Now loading icons."
  226.     OPEN filename$ FOR INPUT AS 1
  227.     x=LOF(1)
  228.     IF x=0 THEN LOCATE ,10:PRINT "No Icons Exist":BEEP:CLOSE 1:RETURN
  229.     FOR count=1 TO 12
  230.         FOR size=0 TO Iconsize%
  231.             INPUT #1,Iconput%(size,count)
  232.         NEXT size
  233.     NEXT count
  234.     CLOSE 1
  235.     count=12
  236.     iconloaded=true
  237.     WINDOW CLOSE 2
  238. RETURN
  239.  
  240.  
  241. Displayicons:
  242.     CLS:TEXTFONT(0)
  243.     x1=30:y1=30:x2=50+x1:y2=50+y1
  244.     i=1
  245.     WHILE i<= count
  246.         IF iconloaded=true THEN PUT(x1,y1)-(x2,y2),Iconput%(0,i) ELSE PICTURE (x1,y1)-(x2,y2),Icon$(i):GET (x1,y1)-(x2,y2),Iconput%(0,i)
  247.         MOVETO (x2-x1)/2+x1,y2+20:PRINT i
  248.         x1=x1+70:x2=x2+70:i=i+1
  249.         IF i=7 THEN x1=30:y1=120:x2=50+x1:y2=50+y1
  250.     WEND
  251. RETURN
  252.  
  253.         
  254.